perm filename SCMSS.OL2[NEW,LCS] blob
sn#445305 filedate 1979-05-29 generic text, type T, neo UTF8
00100 C****** SCMSS *********** 12/1/75
00200 SUBROUTINE SCMSS
00300 COMMON /PLTR/PLT,RHT,DIS/PTR/KWDS(1)
00400 1 /MKX/KSLA,ISM,LESS,IGT,NNO(5),MINUS
00500 COMMON/RINP/R(10,85),RPOS(2,50) /RMOD/RMODE2,SET4,IBEAM,NOSET,
00600 1 STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB /JCHAR/IXX,ISEMI,IBLA
00700 1 /A2Z/LAA,LBB,A1(4),LGG,A2(6),LNN,LOH,A3(3),LSS,LTT,A4(4),LYY
00800 1 /NUM/NUM(9),N9
00900 COMMON R2,JA,G,H,R3,U(39)/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
01000 C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
01100 DIMENSION RLIST(200),NOMOR(6),WARN(6),ISV(5)
01200 C /SCX/ ALSO IN WORDS, NEWR
01300 COMMON/SCX/JALPHA(30),RB,RC,JZ,IRHY,JD,KA,KB,IZ
01400 1/STF/RSTFAC(8),RSTJ2 /LIMIT/LIMIT,ITEM,LL,IS,IX
01500 1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD /IDEV/IDEV
01600 1/XRN/RN(1) /ALF/INP(72),ML /POS/POS1,POS2,PSFB
01700 COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JN,DBST
01800 1,NFLG,JXX,ISEMX,JG,VX(50),IAMP,K,KN,M,MODE,IBLX
01900 EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3)),
02000 1(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST)
02100 1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4))
02200 1,(ISTAR,JALPHA(8)),(ICOL,JALPHA(9)),(IRP,JALPHA(6)),
02300 1(ILP,JALPHA(5)),(NEG,JALPHA(2)),(IAT,JALPHA(16)),(IDOT,
02400 1JALPHA(3))
02500 C--THESE ARE IN 'RESTS' NOW. DATA IXX/'X'/,LCNT/1/,ISEMI/';'/,IBLA/' '/
02600 JDEV=IDEV
02700 1177 RB=0
02800 CC IF(JA.EQ.140)GO TO 77
02900 CC IF(JA.NE.144)GO TO 11
02950 IF(JA.NE.140)GO TO 11
03000 77 MODE=1
03050 IF(IDEV.EQ.5)WRITE(21,2114)INP
03075 C WRITE OUT 'IN' ETC.
03100 IBEAM=-1
03200 IZ=0
03300 CC IREAD=0
03400 POS2=0
03500 POS1=0
03600 CC THIS IS SET IN MSX NOW **** RMODE2=R3
07700 91 CALL TYPSTR('SPACING STAFF =')
07800 CALL TYPFLT(SET4)
07900 CALL TYPCRLF
08000 GO TO 111
08100
08200 491 RB=0
08326 CALL TYPSTR('STAFF NUM=')
08389 ACCEPT 80052,STAFF
08578 CALL A2READ(RA,RB)
08641 IF(RA.NE.'SP')GO TO 91
08704 C NOW SPACER CAN BE SET AT THIS POINT
08767 SET4=RB
08830 GO TO 111
08900 11 RB=0
09000 GO TO 111
09100 467 IDEV=5
09200 GO TO 4333
09300 444 SET4=RA
09400 111 CALL SETUP
09500 IF(STUP.GE.0)GO TO 8
09600 C SKIPS IF USING SETUP ON SOME STAFF
09700 IF(POS2.NE.0)GO TO 4334
09800 C JUMP IF POS1, POS2, ETC. WERE SET UP IN FILE (* SP ST POS1 POS2 X)
09900 4333 IF(IDEV.EQ.5)CALL TYPSTR('TYPE POS1, POS2, (SPC) ')
10000 READ(IDEV,F78F,END=467)POS1,POS2,PSFB
10100 C DON'T USE INVIS. RESTS WITH SPACING FEATURE!!!!
10200 IF(IDEV.NE.5)GO TO 5333
10300 REREAD 2114,INP
10350 WRITE(21,2114)INP
10375 C WRITE OUT SPACING INFO
10400 5333 CALL A2READ(K,RA)
10500 IF(K.EQ.'SP')GO TO 444
10600 C TYPE "SPn" TO SET SPACING STAFF AT THIS POINT.
10700 IF(K.EQ.IAT)GO TO 467
10800 CATCH '@' WHEN POS1 AND P2 ARE EXPECTED.
10900 IF(K.EQ.LESS)GO TO 467
11000 IF(K.NE.IGT)GO TO 567
11100 IDEV=1
11200 GO TO 4333
11300 567 IF(POS2.EQ.0)POS2=200.
11400 IF(POS1.GE.POS2)GO TO 4333
11500 C TYPE ANY POSITIVE 3RD NUM. FOR PSUEDO-FIBONACCI SPACING OF RHYTH.
11600 4334 STUP=STUP-PSFB
11800
12100 8 CALL TYPCRLF
12200 IF(RB.GT.0)GO TO 891
12400 367 GO TO (1,2,3,4,5,677)MODE
12600 GO TO 2177
12900 C************ IS NEXT NEEDED (SEE AT 667) ???∂*************
13000 2303 RB=0
13400 POS2=0
13600 GO TO 491
13700
14800 167 IDEV=5
14900 891 CALL TYPSTR('STAFF NUM=')
15000 CC IF(RB)GO TO 231
15100 IF(STFNUM(STAFF))GO TO 2305
15200 231 CALL TYPFLT(STAFF)
15300 CC IF(RB.GE.0)GO TO 2177
15350 GO TO 2177
15400 CALL TYPCRLF
15600 GO TO 91
16500 2305 READ(IDEV,80052,END=167)STAFF
16600 IF(STAFF.NE.444)GO TO 2177
16900 CALL A2READ(RA,RB)
17000 IF(RA.EQ.LESS)GO TO 167
17100 IF(RA.NE.IGT)GO TO 667
17200 IDEV=1
17300 GO TO 891
17400 667 IF(RA.NE.'SP')GO TO 2177
17500 C NOW SPACER CAN BE SET AT THIS POINT
17600 SET4=RB
17700 GO TO 2303
17800 2310 FORMAT(A1,5F)
17850 2177 GO TO 80041
18000 IF(STAFF.GE.99)GO TO 690
18100 C TYPE 99 OR 999 TO ESCAPE WHEN IN READ-IN MODE
18200 REND=0
18250 GO TO 80041
21300 2111 IDEV=JDEV
21400 RETURN
21500 CC168 IF(NOSET.EQ.0)RETURN
21600
21700 80052 FORMAT(F,A4,A5,2F)
21800 267 IDEV=5
21900 IF(MODE.EQ.3)CALL NOTNUM
22000 GO TO 2111
22200 4 IF(IDEV.EQ.5)CALL TYPSTR('ADD BEAMS? ')
22300 330 READ(IDEV,2114,END=677)INP
22500 CALL LULOOP
22600 IF(INP1.EQ.LGG)GO TO 677
22800 C TYPE 'GO' TO PASS LATER ITEMS
22900 IF(INP1.EQ.N9.AND.INP2.EQ.INP1)GO TO 99
23000 IF(INP1.EQ.LBB)GO TO 99
23100 IF(INP1.EQ.LYY)GO TO 1
23200 C FOR BEAMS? TYPE 'nB' INSTEAD OF 'Y' FOR AUTOMATIC.
23300 IF(INP1.EQ.LNN)GO TO 2000
23400 IF(INP1.EQ.ISEMI)GO TO 2000
23500 IF(INP1.EQ.LESS)GO TO 267
23600 IF(INP1.NE.IGT)GO TO 767
23700 IDEV=1
23800 GO TO(1,2,3,4,5)MODE
23900 767 IF(INP1.NE.IBLA)GO TO 5177
24000 2000 MODE=MODE+1
24100 IF(IDEV.EQ.5)WRITE(21,2114)INP4
24200 GO TO 11
24700 690 REND=1
24800 GO TO 2111
25000 3 IF(IDEV.EQ.5)CALL TYPSTR('ADD MARKS? ')
25100 GO TO 330
25200 5 IF(IDEV.EQ.5)CALL TYPSTR('ADD SLURS? ')
25300 GO TO 330
25400
25500 8006 MODE=MODE+1
26000 IF(MODE.GT.5)GO TO 677
26100 IF(IDEV.NE.5)GO TO 367
26200 C RETURN ONLY IF IN TTY MODE. (NOT READING A FILE)
26300 GO TO 2111
26400 677 IF(IDEV.NE.5)GO TO 68
26500 END FILE 21
26600 CALL TYPSTR('INPUT SAVED ON FOR21.DAT')
26700 CALL TYPCRLF
26800 68 REND=-1
26900 GO TO 2111
27100
27200 99 IF(INP3.EQ.N9)GO TO 999
27300 C ELSE GET ANOTHER CHANCE TO SAY 'NO'. 99=BACKUP, 999=ESCAPE
27400 MODE=MODE-1
27500 IF(MODE.EQ.0)GO TO 999
27600 IS=ISV(MODE)
27700 GO TO 11
27800 C INSERT BACKUP ROUTINE
27900 999 REND=99
28000 GO TO 2111
28100 C FIX BACKUPS********
28200
28300 8015 RA=0
28400 DO 15 J=1,I-1
28500 15 RA=RA+4./V(J)
28600 K=IRHY-I+1
28700 CALL TYPSTR('TOTAL RHY=')
28800 CALL TYPFLT(RA)
28900 CALL TYPSTR(' QTRS. ')
29000 CALL TYPINT(K)
29100 CALL TYPSTR(' MORE RHYTHMS NEEDED')
29200 CALL TYPCRLF
29300 IDEV=5
29400 C RETURNS TO TTY MODE IF READING A FILE WITH 'FILE' FEATURE.
29700 2 IF(IDEV.EQ.5)CALL TYPSTR('TYPE ')
29800 CALL TYPINT(IRHY)
29900 CALL TYPSTR(' RHYTHMS')
30000 CALL TYPCRLF
30100
30200 1 ISV(MODE)=IS
30300 CALL TYPE
30400 IF(INP1.NE.IAT)GO TO 1001
30500 C '@' STARTS MODE2 INPUT
30600 IF(INP2.NE.IBLA)GO TO 1001
30700 C BUT NOT IF IT'S REALLY A MOTIVE CALL
30750 IF(IDEV.EQ.5)END FILE 21
30775 C CLOSE THE BACKUP FILE
30800 CALL PRESCN
30900 CALL IFILE(22,'MODE2')
31000 READ(22,2114)INP
31100 CALL LULOOP
31300 IDEV=22
31350 C IDEV CHANGES BACK BEFORE RETURN TO MAIN.
31400 Z=STUP
31500 CALL SETUP
31600 C MUST RECALL SETUP BECAUSE SOME ARRAYS WERE USED IN PRESCN.(??)
31700 STUP=Z
31800 GO TO 6177
32100 1001 CALL LULOOP
32200 CALL A2READ(RA,RB)
32300 IF(RA.NE.'SP')GO TO 5177
32400 SET4=RB
32500 C CAN SET SPACER HERE
32600 GO TO 1177
32700 5177 IF(INP1.EQ.IBLA) GO TO 1
32800 IF(INP1.NE.N9)GO TO 80041
32900 IF(INP2.EQ.N9)GO TO 99
33000 C TYPE '99' TO BACK-UP
33200 80041 IF(IDEV.EQ.5)WRITE(21,2114)INP
33300 6177 CALL LNEND
33400 GO TO(333,433,533)MODE-2
33500 C GO TO MARKZ, BEAMS, SLURZ
33600 RETRO=-1.
33700 I=1
33800 PARENS=0
33900 MOT=0
34000 JZ=1
34100 IAMP=0
34200 C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
34300 KL=0
34400 RA=0
34500 IF(MODE.EQ.2)GO TO 2408
34600 C NEXT CHECKS FOR STAFF NUM AT FRONT OF INPUT LINE#1.
34700 IF(INP1.NE.LSS)GO TO 2408
34800 IF(INP2.NE.LTT)GO TO 2408
34900 K=1
35000 L=3
35100 IF(INP3.NE.MINUS)GO TO 1277
35200 K=-1
35300 L=4
35400 1277 STAFF=NALF(INP(L))*K
35500 2277 MLX=L+1
35600 IF(INP(MLX).NE.KSLA)GO TO 2277
35700 MLX=MLX+1
35800 GO TO 3277
35900 2408 MLX=1
36000 3277 L=-1
36200 C GO SORT OUT THE NEW FORMAT
36300 DO 2999 K=1,72
36400 N=INP(K)
36500 IF(N.EQ.IBLA)GO TO 2999
36600 L=0
36700 IF(N.EQ.ISTAR)GO TO 277
36800 IF(N.NE.ISEMI)GO TO 2999
36900 C READS 72 CHARS. INCLUDING ;.
37000 277 INP(K+1)=ISEMI
37100 GO TO 1773
37200 C --- X/Y/Z* --- WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
37300 2999 CONTINUE
37400 IF(IREAD)GO TO 8015
37500 CALL TYPSTR('****** TRY AGAIN ***** ')
37600 CALL TYPCRLF
37700 GO TO 1
37800
37900 1299 IF(JZ.NE.0)GO TO 1773
39200 7773 CALL TYPE
39300
39400 IF(INP1.EQ.IBLA)GO TO 7773
39500 IF(IDEV.EQ.5)WRITE(21,2114)INP
39600 CALL LULOOP
39700 77732 CALL LNEND
39800 JM=-1
39900 JZ=0
40000 GO TO 2408
40100 C 'LISTS' MUST END WITH ;
40200 1773 JZ=0
40300 DBST=1.
40400 IF(XDBST)DBST=-DBST
40500 XDBST=0
40600 17731 ML=MLX
40700 IF(PARENS.LE.0.)GO TO 975
40800 C PARENS=-1, OPENS; =1, CLOSES; =0, NONE
40900 3362 PARENS=0
41000 MOT=I-LMOT
41100 IF(LCNT+MOT.LT.198)GO TO 33621
41200 CALL TYPSTR(' NO ROOM FOR MOTIVE ')
41300 CALL TYPCHR(JMOT,1)
41400 CALL TYPCRLF
41500 GO TO 1
41600 33621 JLIST(LCNT+1)=MOT
41700 LCNT=LCNT+2
41800 DO 2140 JG=0,MOT-1
41900 2140 RLIST(LCNT+JG)=V(LMOT+JG)
42000 LCNT=LCNT+MOT
42100 IF(IAMP)GO TO 3013
42200 C FOR CLOSE PARENS ON LAST ITEM
42300 C STORE MOTIVE IN RLIST ARRAY
42400
42500 975 DO 236 JDD=ML,72
42600 JD=JDD
42700 N=INP(JD)
42800 C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC. CAN USE 26 LABELS.
42900 IF(N.EQ.ILP)GO TO 477
43000 IF(N.EQ.IRP)GO TO 477
43100 IF(N.NE.ICOL)GO TO 2361
43200 477 INP(JD)=IBLA
43300 IF(N.NE.ICOL)GO TO 1113
43400 XDBST=-1.
43500 GO TO 5362
43600 C GO CHANGE IT TO A SEMIC. !!! CAN'T END LINE WITH :
43700 C SO NXT NOTE WILL BE DBST (TYPE /F:A:C/ ETC.)
43800 C DBSTS WILL BE ONLY ONE 'REP' UNIT X*0Z%~#&@
43900 1113 L=JD-1
44000 5113 IF(INP(L).NE.IBLA)GO TO 2113
44100 L=L-1
44200 GO TO 5113
44300 2113 IF(N.EQ.IRP)GO TO 3361
44400 C ONLY ONE () AS YET, NO NESTING
44500 1140 JMOT=INP(L)
44600 C MOTIVE NAME
44700 DO 11401 JC=1,LCNT-1
44800 IF(JMOT.NE.JLIST(JC))GO TO 11401
44900 C FINDS DUPLICATE IDENTIFIER
45000 CALL TYPSTR(' MOTIVIC (')
45100 CALL TYPCHR(JMOT,1)
45200 CALL TYPSTR(') USED TWICE')
45300 CALL TYPCRLF
45400 JLIST(JC)=0
45500 C ZERO OUT PREVIOUS USE OF IDENTIFIER.
45600 11401 CONTINUE
45700 JLIST(LCNT)=JMOT
45800 PARENS=-1.
45900 C A PARENTH IS OPEN
46000 INP(L)=IBLA
46100 LMOT=I
46200 C LMOT IS CURRENT POINT IN V ARRAY
46300 GO TO 236
46400 3361 IF(PARENS.NE.0)GO TO 33612
46500 CALL TYPSTR('PARENTH ERROR - GOING ON')
46600 CALL TYPCRLF
46700 33611 INP(JD)=IBLA
46800 GO TO 236
46900 33612 PARENS=1.
47000 C SETS PARENS CLOSED FLAG
47100 GO TO 33611
47200 C NO INVERSIONS POSSIBLE NOW
47300 2361 IF(N.NE.IAT)GO TO 5361
47400 DO 113 L=1,72
47500 K=JD+L
47600 C K IS USED AT 240!!!
47700 JG=INP(K)
47800 IF(JG.NE.NEG)GO TO 7113
47900 RETRO=0
48000 INP(K)=IBLA
48100 GO TO 113
48200 7113 IF(JG.NE.IBLA)GO TO 4113
48300 113 CONTINUE
48400 4113 DO 6361 L=1,LCNT
48500 IF(JG.NE.JLIST(L))GO TO 6361
48600 VX1=0
48700 DO 40 M=JD+2,72
48800 JG=INP(M)
48900 IF(JG.EQ.IBLA)GO TO 40
49000 IF(JG.EQ.KSLA)GO TO 140
49100 IF(JG.EQ.ISEMI)GO TO 140
49200 IF(JG.EQ.ISTAR)GO TO 140
49300 ML=M
49400 GO TO 240
49500 40 CONTINUE
49600 240 JC=JM
49700 JM=-1
49800 INP(K)=IBLA
49900 JN=0
50000 C MUST BE ZERO IN SCANR
50100 CALL SCANR
50200 JM=JC
50300 140 JC=1
50400 KN=L+2
50500 M=KN+JLIST(L+1)
50600 IF(RETRO)GO TO 940
50700 KN=M-1
50800 M=L+1
50900 JC=-1
51000 RETRO=-1.
51100
51200 940 Z=RLIST(KN)
51300 IF(VX1.EQ.0)GO TO 540
51400 C " @Q N " WHERE N= DIATONIC STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
51500 IF(MODE.EQ.1)GO TO 440
51600 C MODE 1 IS NOTES, 2 IS RHY.
51700 V(I)=Z*VX1
51800 GO TO 7361
51900 440 IF(ABS(Z).GE.2000.)GO TO 540
52000 C SKIPS NON-NOTES
52100 RB=VX1
52200 IF(Z)RB=-RB
52300 C NOW TRANSPOSES BY DIAT. STEPS ONLY 100S=FLAT, 200S=SHARP, 300S=NAT
52400 C NEG NUMS ARE CHORD NOTES.
52500 V(I)=Z+RB
52600 GO TO 7361
52700 540 V(I)=Z
52800 7361 I=I+1
52900 KN=KN+JC
53000 IF(KN.NE.M)GO TO 940
53100
53200 RB=V(I-1)
53300 DO 8361 L=JD,72
53400 JG=INP(L)
53500 INP(L)=IBLA
53600 IF(JG.EQ.KSLA)GO TO 9361
53700 IF(JG.EQ.ISEMI)GO TO 93611
53800 8361 IF(JG.EQ.ISTAR)IAMP=-1
53900 9361 MLX=L
54000 IF(IAMP.EQ.0)GO TO 17731
54100 JZ=-1
54200 93611 IF(IAMP)GO TO 3013
54300 GO TO 7773
54400 6361 CONTINUE
54500 CALL TYPSTR(' MOTIVIC (')
54600 CALL TYPCHR(JG,1)
54700 CALL TYPSTR(') NOT FOUND')
54800 CALL TYPCRLF
54900 GO TO 11401
55000 C @@@@@@@@@@@@@@@@@@@@@@@@@@
55100 5361 IF(N.NE.KSLA)GO TO 636
55200 5362 MLX=JD+1
55300 JZ=-1
55400 INP(JD)=ISEMI
55500 436 IF(INP(MLX).NE.IBLA)GO TO 103
55600 MLX=MLX+1
55700 GO TO 436
55800 636 IF(N.EQ.ISEMI)GO TO 103
55900 936 IF(N.NE.IDOT)GO TO 736
56000 L=INP(JD+1)
56100 KL=NALF(L)
56200 IF(L.LE.0)GO TO 577
56300 IF(KL.LT.0)GO TO 577
56400 IF(KL.LE.9)GO TO 236
56500 C JUMP IF IT'S A NUMBER
56600 577 IF(MODE.EQ.2)INP(JD)=1
56700 C :::::::::******* ↑↑↑↑ MODE #?
56800 GO TO 236
56900 C CHANGES DOTTED RHYTHMS TO '1'S.
57000 736 IF(N.NE.ISTAR)GO TO 236
57100 IAMP=-1
57200 INP(JD)=ISEMI
57300 GO TO 103
57400 236 CONTINUE
00100 2114 FORMAT(72A1)
00200 21141 FORMAT(I,72A1)
00300
00400 5016 IF(IAMP.GE.0)GO TO 1299
00500 IF(PARENS.NE.0)GO TO 3362
00600 C PARENS ARE STILL OPEN?
00700 GO TO 3013
00800 103 K=INP(ML)
00900
01000 C LAST SECTION
01100 IF(K.EQ.ISEMI)GO TO 1014
01200 C*********** MODE #?
01300 IF(K.NE.IBLA) GO TO 1899
01400 ML=ML+1
01500 GO TO 103
01600 1899 JN=0
01700 C MUST BE ZERO IN SCANR
01800 VX4=0
01900 NOAC=0
02000 CALL SCANR
02100 IF(VX1.EQ.-99.)GO TO 4022
02200 C NO MORE COMPOSITES IN RHYTH. DOTS ARE INDICATED BY 100S.
02300 C RHYTH. NUMB IS KEPT HERE. DOTTED QUARTER IS NOW 104. DBL..=204
02400 17 IF(MODE.NE.2)GO TO 117
02500 IF(JJ.EQ.1)GO TO 117
02600 IF(VX2.EQ.0)GO TO 117
02700 C VX2=0 IF "X" IS USED. (8X3 FORMS VX1=8, VX2=0, VX3=3)
02800 RB=0
02900 DO 2117 K=1,JJ
03000 2117 RB=RB+4./VX(K)
03100 VX1=4./RB
03200 C FOR COMPOSITE RHYTHMS. (USEFUL FOR 'WHOLE' RESTS IN 5/4, ETC.)
03300 JJ=1
03400 117 V(I)=VX1
03500 IF(VX4.EQ.0)GO TO 115
03600 IF(MODE.NE.1)GO TO 115
03700 I=I+1
03800 C FOR + OR -. AUTO OCTAVES, ETC.
03900 V(I)=-VX1-VX4
04000 115 IF(JJ.LE.1)GO TO 114
04100 IF(MODE.NE.1)GO TO 171
04200 IF(VX2.EQ.0)GO TO 171
04300 C JUMP IF RHY OR 'X 4' ETC.
04400 V(I)=18000.0+VX1*10.0+VX2/10.0
04500 C PACKS 2 METER NUMS INTO ONE SLOT (18xyz.n xy=top, zn=bottom)
04600 114 I=I+1
04700 GO TO 5016
04800 171 JC=1
04900 JD=VX(JJ)-1
05000 I=I+1
05100 GO TO 5005
05200 1014 JD=1
05300 JC=1
05400 C X4/ CREATES REP 1,4; A/// CREATES REP 1,3;
05500 GO TO 5005
05600 4022 JC=VX2+.3
05700 JD=VX3-.5
05800 IF(MODE.EQ.1)NOAC=-1
05900 C ACCIS WILL NOT!! REPEAT UNLESS 100 IS ADDED TO 1ST NUM.******6/78
06000 IF(JJ.EQ.2)JD=1
06100 C JD=HOW MANY TIMES, JC=HOW MANY NOTES
06200 IF(JC.LT.100)GO TO 5005
06300 C ADD 100 TO NUM OF NOTES TO REPEAT ACCIS WITH 'REP N1, N2'.
06400 JC=JC-100
06500 NOAC=0
06600 5005 N=0
06700 DO 3005 K=I-1,1,-1
06800 IF(V(K))GO TO 3005
06900 IF(V(K).LT.3000)N=N+1
07000 C COUNTS RESTS AND NOTES ONLY (NO CHORD NOTES)
07100 3005 IF(N.EQ.JC)GO TO 4005
07200 4005 IF(JC.GT.1)GO TO 7005
07300 IF(MODE.EQ.1)NOAC=-1
07400 C 5/76 ******* AF/// WILL CREATE AF/A//-- AN:FS/// = AN:FS/A:F// *******
07500 C ACCIS ARE DROPPED WITH / OR Xn REPEAT. (BUT NOT WITH 'REP' OR '/X n,n/')
07600 7005 JC=I-K
07700 C ALL THIS IS TO FIND COMPLETE CHORDS, BARS, ETC. TO REPEAT.
07800 C REPS WILL ONLY COUNT RHYTHMIC UNITS.!
07900 DO 1005 K=1,JD
08000 NL=I+JC-1
08100 DO 2005 L=I,NL
08200 KN=L-JC
08300 RB=V(KN)
08400 IF(NOAC.GE.0)GO TO 2005
08500 IF(ABS(RB).GE.2000)GO TO 2005
08600 C SKIP OVER IF NOT A NOTE
08700 RB=AMOD(RB,100.0)+1000.0
08800 IF(V(KN))RB=RB-2000.0
08900 C DROPS ACCIS WHEN SLASH REP. OR 'X' IS USED.
09000 2005 V(L)=RB
09100 1005 I=I+JC
09200 GO TO 5016
09300
09400 3013 IF(MODE.NE.2)GO TO 771
09500 IF(I-1.NE.IRHY)GO TO 8015
09600 C WRONG NUMBER OF ITEMS
09700 771 V(I)=-99.
09800 IF(MODE.NE.1)GO TO 132
09900 C FOR ADDED NOTES ON SPACING STAFF
10000 CALL NOTES
10100 C SAVES TOTAL OF ITEMS FOR LABEL 168
10200 67 CALL NEWR
10300 IX=IS
10400 C SAVE PTR TO RN ARRAY FOR TREM. OVER BEAM LATER. (IN 'BEAMS.F4')
10500 GO TO 8006
10700 132 CALL RHYTH
10800 C =50 IS RHYTHM FOR TEXT
10900 GO TO 67
11000 134 IF(IDEV.EQ.5)WRITE(21,2114)INP
11100 C WRITES TYPED IN REPLY TO 'ADD BEAMS?'
11200 C ACCENTS ARE IN MARKZ SUBROUTINE
11300 GO TO 8006
11400 533 CALL SLURZ
11500 GO TO 8006
11600 433 CALL BEAMS
11700 C ADJUSTS STEMS (IBEAM=0) IF BEAMS WERE ENTERED.
11800 IBEAM=0
11900 GO TO 8006
12000 333 CALL MARKZ
12100 135 K=IS
12200 CALL NEWR
12300 IS=K
12400 C ↑↑↑↑↑↑ TO ADD NEW ITEMS, SUCH AS PPP, MP, CRESC., ETC.(SEE 'MARKS')
12500 GO TO 8006
12600 END
12700
12800 SUBROUTINE A2READ(A,B)
12900 REREAD 1,A,B
13000 CALL LO2UP(A)
13100 1 FORMAT(A2,F)
13200 END